perm filename TRACK.SAI[KI,ALS]1 blob
sn#093374 filedate 1974-03-25 generic text, type T, neo UTF8
00010 ENTRY TRACK;
00020 BEGIN
00030 DEFINE ⊂="COMMENT",CR="'15",LF="'12", CRLF="CR&LF",TB="'11";
00040 DEFINE ⊃="⊂"; ⊂ Used to introduce debugging outstr's;
00050 INTEGER I,J,K,L,M,VSTART,VEND,POINTR,OLDBUF,EOF,SMIN,SMAX,PSTART,PEND;
00060 INTEGER ALPHA,SAMPLE,ISAVE,ZEROS,GAMMA;
00070 EXTERNAL INTEGER CHAN3;
00080 BOOLEAN ER;
00090 REAL VAL,X,Y,Z;
00100 INTEGER ARRAY BUF1,BUF2,HOLD[0:512];
00110 INTERNAL REAL ARRAY A,B,WINDOW[0:512];
00120 EXTERNAL INTEGER F1,F2,F3,A1,A2,A3;
00130 INTERNAL REAL ARRAY C[0:512];
00140 EXTERNAL INTEGER ARRAY SPOOR[0:5,0:20];
00150 EXTERNAL INTEGER SPX;
00160 INTERNAL INTEGER F1AS,F1S,F2S,F3S,F4S,F5S;
00170 INTERNAL REAL CF1S;
00180
00190
00200 ⊂ DEFINE \=" "; DEFINE \="SAFE"; ⊂ Alternarte definitions;
00210 REQUIRE "LPC[X,ALS]" LOAD_MODULE;
00220 REQUIRE "INDATK[KI,ALS]" LOAD_MODULE;
00230 EXTERNAL INTEGER ARRAY INNAME,INDATA[0:32];
00240 EXTERNAL PROCEDURE DEFINES;
00250 EXTERNAL PROCEDURE PREPARE;
00260 EXTERNAL INTEGER INFLAG,NX;
00270 FORTRAN REAL PROCEDURE SQRT(REAL X);
00280 FORTRAN REAL PROCEDURE ALOG10(REAL X);
00290 FORTRAN REAL PROCEDURE COS(REAL X);
00300 FORTRAN REAL PROCEDURE SIN(REAL X);
00310 INTEGER ZEROC,ZEROF,DX;
00320 EXTERNAL FORTRAN PROCEDURE LPC(REFERENCE REAL AIFFY,SPT;
00330 REFERENCE INTEGER NPTS,M,NSP);
00340 REQUIRE "FFT8X[X,ALS]" LOAD_MODULE;
00350 EXTERNAL FORTRAN PROCEDURE FRXFM
00360 (REFERENCE INTEGER M;REFERENCE REAL X,Y);
00370
00380 INTERNAL PROCEDURE FORM(INTEGER LPCOPT);
00390 BEGIN "FORM"
00400 REAL ERRN,ERR;
00410 INTEGER I,J,LP,JJP,N,M;
00420
00430 IF LPCOPT=1 THEN BEGIN "FFT"
00440 M←9; N←2↑M; DEFINE PI="3.141592653";
00450 ⊃ OUTSTR("Entering FORM"&CRLF);
00460
00470 N←PEND-PSTART; J←0;
00480 ⊃ OUTSTR(CVS(PSTART)&TB&CVS(PEND)&CRLF);
00490 FOR I←0 STEP 1 UNTIL PSTART DO WINDOW[I]←0;
00500 FOR I←PSTART STEP 1 UNTIL PEND DO BEGIN
00510 WINDOW[I]←(1-COS((2*PI*J)/N))/2;
00520 J←J+1; END;
00530 FOR I←PEND+1 STEP 1 UNTIL 512 DO WINDOW[I]←0;
00540 FOR I←0 STEP 1 UNTIL 512 DO BEGIN
00550 A[I]←HOLD[I]*WINDOW[I]; B[I]←0;
00560 END;
00570
00580
00590 FRXFM(M,A[0],B[0]);
00600 ⊃ OUTSTR("FFT COMPLETE"&CRLF);
00610 FOR I←0 STEP 1 UNTIL 256 DO BEGIN
00620 X←(A[I]↑2)+(B[I]↑2)+1.*(10↑-37);
00630 C[I]←10.*ALOG10(X);
00640 END;
00650
00660 END "FFT" ELSE BEGIN "LPC"
00670
00680 ⊃ OUTSTR("Entering LPC"&CRLF);
00690 I←PSTART; N←PEND-PSTART;
00700 LPC(HOLD[I],C[0],N,M,256);
00710 END "LPC";
00720
00730 END "FORM";
00740
00750
00760 PROCEDURE REPLACE;
00770 BEGIN
00780
00790 FOR I←0 STEP 1 UNTIL 511 DO BUF1[I]←0;
00800 ⊃ OUTSTR("Ready to reload BUF1"&CRLF);
00810 POINTR←POINT(12,BUF1[0],-1);
00820 ARRYIN(CHAN3,BUF1[0],512);
00830 OLDBUF←OLDBUF+1; I←0; SAMPLE←SAMPLE+1536;
00840
00850 ⊃ OUTSTR("Sample="&CVS(SAMPLE)&CRLF);
00860 END;
00870
00880 INTEGER ARRAY PEAK,NPEAK,PLACE,NPLACE,PEAKX,NPEAKX[0:3];
00890
00895 INTEGER XING;
00900 INTERNAL PROCEDURE TRACK;
00910 BEGIN
00920 INTEGER MAX,MAXX,MIN,MINX,STATE,MAXOLD,MINOLD,OLDXX,OLDNX,PERIOD;
00930
00940 ALPHA←800; SAMPLE←0; GAMMA←40; PERIOD←170;
00950 SAMPLE←0;
00960
01030 ARRYIN(CHAN3,BUF1[0],512);
01040 ⊃ OUTSTR("Initial load of BUF1 "&CRLF);
01050 OLDBUF←0; VSTART←0; POINTR←VEND←POINT(12,BUF1[0],-1); I←0;
01060 SPX←0; DEFINES; INFLAG←0; PREPARE; INFLAG←1;
01070
01080 WHILE EOF=0 DO BEGIN "TRACK"
01090
01100 ⊂ Find a possible vowel region;
01110 WHILE EOF=0 DO BEGIN "SKIP"
01120 K←ILDB(POINTR); IF K≥2047 THEN K←4096-K; ⊂ Make positive here;
01130 I←I+1; IF (I≥1536)∧(EOF=0) THEN REPLACE;
01140 IF I≥1536 THEN DONE "TRACK";
01150 IF K≥ALPHA THEN DONE "SKIP";
01160 END "SKIP";
01170 OUTSTR(CRLF&"Vowel number "&cvs(SPX)&" at "&CVS(SAMPLE+I)&CRLF);
01180
01190 ⊂ Ignore the first pitch period;
01200 FOR J←0 STEP 1 UNTIL 200 DO BEGIN
01210 IBP(POINTR);
01220 I←I+1; IF (I≥1536)∧(EOF=0) THEN REPLACE;
01230 IF I≥1536 THEN DONE "TRACK";
01240 END;
01250
01260 ISAVE←SAMPLE+I;
01270 HOLD[0]←K; IF K>0 THEN STATE←0 ELSE STATE←1;
01275 MAX←MIN←MAXOLD←MINOLD←XING←0;
01290
01300
01310 FOR K←0 STEP 1 UNTIL 2 DO PEAK[K]←NPEAK[K]←0;
01320 ZEROS←0;
01330 FOR J←1 STEP 1 UNTIL 511 DO BEGIN "SAVE"
01340 K←ILDB(POINTR); IF K>2047 THEN K←K-4096;
01350 HOLD[J]←K;
01360 I←I+1; IF (I≥1536)∧(EOF=0) THEN REPLACE;
01370 IF I≥1536 THEN DONE "TRACK";
01380
01390 IF STATE=0 THEN BEGIN
01400 IF K>MAX THEN BEGIN MAXX←J; MAX←K; END;
01410 IF K<0 THEN BEGIN
01420 IF (MAX>MAXOLD)∨(MAXX>OLDXX+PERIOD%2) THEN BEGIN
01425 MAXOLD←MAX; OLDXX←MAXX;
01430 FOR L←0 STEP 1 UNTIL 2 DO IF MAX<PEAK[L] THEN DONE;
01440 IF L>0 THEN FOR L←L-1 STEP -1 UNTIL 0 DO BEGIN
01450 MAX↔PEAK[L]; MAXX↔PLACE[L]; XING↔PEAKX[L]; END;
01470 END;
01480 MAX←0; STATE←1; XING←J; END;
01485
01490 END ELSE BEGIN
01495
01500 IF K<MIN THEN BEGIN MINX←J; MIN←K; END;
01520 IF K>0 THEN BEGIN
01530 IF (MIN<MINOLD)∨(MINX>OLDNX+PERIOD%2) THEN BEGIN
01535 MINOLD←MIN; OLDNX←MINX;
01540 FOR L←0 STEP 1 UNTIL 2 DO IF MIN>NPEAK[L] THEN DONE;
01550 IF L>0 THEN FOR L←L-1 STEP -1 UNTIL 0 DO BEGIN
01560 MIN↔NPEAK[L]; MINX↔NPLACE[L]; XING↔NPEAKX[L]; END;
01580 END;
01590 ZEROS←ZEROS+1;
01600 MIN←0; STATE←0; XING←J; END;
01610 END;
01620 ⊂ OUTSTR(CVS(K)&TB);
01630 END "SAVE";
01640
01650 FOR J←0 STEP 1 UNTIL 2 DO
01660 OUTSTR(CVS(PEAKX[J])&TB&CVS(PLACE[J])&TB&CVS(PEAK[J])&TB
01670 &TB&CVS(NPEAKX[J])&TB&CVS(NPLACE[J])&TB&CVS(NPEAK[J])&CRLF);
01680
01690 K←0;
01700 FOR J←0 STEP 1 UNTIL 2 DO K←K+PEAK[J]-NPEAK[J];
01710 OUTSTR("SIGMA="&CVS(K)&TB&"ZEROS="&CVS(ZEROS)&CRLF);
01720 IF K<ALPHA*4 THEN BEGIN
01730 OUTSTR("Woops, not a vowel"&crlf);
01740 CONTINUE "TRACK"; END;
01750
01760 IF ZEROS>GAMMA THEN BEGIN
01770 OUTSTR("Woops, too many zeros"&CRLF);
01780 CONTINUE "TRACK"; END;
01790
01800 ⊂ Find positive side;
01810 K←0;
01820 FOR J←0 STEP 1 UNTIL 2 DO K←K+PEAK[J]+NPEAK[J];
01830 ⊃ IF K<0 THEN OUTSTR("Upside down"&CRLF);
01840 IF K<0 THEN FOR K←0 STEP 1 UNTIL 2 DO BEGIN
01845 PEAKX[K]↔NPEAKX[K];
01850 PLACE[K]↔NPLACE[K]; PEAK[K]↔NPEAK[K]; END;
01860
01870 FOR K←0 STEP 1 UNTIL 1 DO
01880 FOR L←K+1 STEP 1 UNTIL 2 DO
01890 IF PLACE[K]>PLACE[L] THEN BEGIN
01895 PEAKX[K]↔PEAKX[L];
01900 PLACE[K]↔PLACE[L]; PEAK[K]↔PEAK[L]; END;
01910
01920 IF (J←PLACE[2]-PLACE[0])<PERIOD THEN BEGIN
01930 OUTSTR("Too little spread"&CRLF); CONTINUE "TRACK"; END;
01940
01950 IF (PLACE[2]-PLACE[0]<PERIOD*5%4)∧(PEAK[1]<(PEAK[0]+PEAK[2])%2) THEN BEGIN
01960 PSTART←PLACE[0]; PEND←PLACE[2]; END ELSE
01970 IF PLACE[1]-PLACE[0]<PLACE[2]-PLACE[1] THEN BEGIN
01980 PSTART←PLACE[1]; PEND←PLACE[2]; END ELSE BEGIN
01990 PSTART←PLACE[0]; PEND←PLACE[1]; END;
02000
02010 OUTSTR("Pstart="&cvs(PSTART)&" Pend="&CVS(PEND)&" M="&CVS(PEND-PSTART)&CRLF);
02020 PERIOD←(PERIOD+PEND-PSTART)%2;
02030
02040 FORM(1);
02050 PREPARE;
02060 ⊃ FOR J←0 STEP 1 UNTIL 9 DO OUTSTR(CVS(INDATA[J])&TB);
02070
02080 J←0; SPOOR[0,SPX]←ISAVE+PSTART;
02090 OUTSTR("ISAVE="&CVS(ISAVE)&TB&"PSTART="&CVS(PSTART)&TB&"SPOOR[0,SPX]="&CVS(SPOOR[0,SPX])&CRLF);
02100
02110 FOR K←1 STEP 1 UNTIL 3 DO BEGIN
02120 SPOOR[K,SPX]←INDATA[J]*2500%256; J←J+1; END;
02130
02140 J←6;
02150 FOR K←4 STEP 1 UNTIL 6 DO BEGIN
02160 SPOOR[K,SPX]←INDATA[J]; J←J+1; END;
02170
02180 SPX←SPX+1; IF SPX≥20 THEN SPX←20;
02190 ⊂ Go to end of this vowel;
02200 M←PEND-PSTART; L←0;
02210 FOR J←PEND STEP 1 UNTIL 511 DO BEGIN
02220 IF (HOLD[J]<ALPHA)∧(HOLD[J]>-ALPHA) THEN L←L+1 ELSE L←0;
02230 IF L>PERIOD*5%4 THEN DONE; ⊂ At the end of the vowel;
02240 END;
02250
02260 IF J≥512 THEN BEGIN ⊂ Not at the end of the vowel;
02270 WHILE EOF=0 DO BEGIN
02280 K←ILDB(POINTR); IF K≥2047 THEN K←4096-K; ⊂ Make positive here;
02290 I←I+1; IF (I≥1536)∧(EOF=0) THEN REPLACE;
02300 IF I≥1536 THEN DONE "TRACK";
02310 IF K<ALPHA THEN L←L+1 ELSE L←0;
02320 IF L>PERIOD*5%4 THEN DONE;
02330 END;
02340 END;
02350
02360 END "TRACK";
02370 END;
02380 END;